home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 037a / plx13.zip / WOPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-13  |  14KB  |  560 lines
  1. {WOPLUS - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit WOPlus;
  3. {$R woplus.res}
  4.  
  5. {******************************************************************}
  6. { I N T E R F A C E                                                }
  7. {******************************************************************}
  8. interface
  9. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs,
  10.       Printer1,WFPlus;
  11. const
  12.     sr_Recessed     =   1;
  13.   sr_Raised       =   0;
  14. type
  15. PODButton = ^TODButton;
  16. TODButton = object(TButton)
  17.     HBmp :HBitmap;
  18.   State:Integer;
  19.   constructor    Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  20.       X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  21.   destructor    Done;virtual;
  22.   procedure    DrawItem(var Msg:TMessage);virtual;
  23. end;
  24.  
  25.  
  26. type
  27.     PTextObj = ^TTextObj;
  28.   TTextObj = object(TObject)
  29.   Text:PChar;
  30.       constructor Init(NewText:PChar);
  31.     destructor Done;virtual;
  32.     end;
  33.  
  34. type
  35.     PIntObj = ^TIntObj;
  36.   TIntObj = object(TObject)
  37.       Int:Integer;
  38.     constructor Init(NewInt:Integer);
  39.     destructor Done;virtual;
  40.     end;
  41.  
  42. type
  43.     PStack = ^TStack;
  44.     TStack = object(TCollection)
  45.        procedure Push(Item:Pointer);virtual;
  46.     function Pop:Pointer;virtual;
  47.    end;
  48.  
  49.  
  50. {TTextStream}
  51. type
  52. PTextStream = ^TTextStream ;
  53. TTextStream = object(TBufStream)
  54.    CharsToRead : LongInt;
  55.    CharsRead : LongInt;
  56.    ARecord :PChar;
  57.    constructor Init(FileName:PChar;Mode,Size:Word);
  58.    destructor Done;virtual;
  59.    function GetNext:PChar;virtual;
  60.    function WriteNext(szARecord:PChar):integer;virtual;
  61.    function WriteEOF:integer;virtual;
  62.    function IsEOF:Boolean;virtual;
  63.    function GetPctDone:Integer;
  64. end;
  65.  
  66.  
  67. {TMeter}
  68. type
  69. PMeterWindow = ^TMeterWindow;
  70. TMeterWindow = object(TWindow)
  71.   TheRedBrush:HBrush;
  72.   TheGrayBrush:Hbrush;
  73.   ThePen:HPen;
  74.   X,Y,dX,dY,mX :Integer;
  75.   PctDone :Integer;
  76.   Icon:HIcon;
  77.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  78.   procedure   SetupWindow;virtual;
  79.   destructor  Done; virtual;
  80.   procedure   Draw(NewPctDone:Integer);virtual;
  81.   procedure    Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  82. end;
  83.  
  84. type                               {Printer object support for margins,fonts}
  85. PWOPrinter = ^TWOPrinter;
  86. TWOPrinter = object(tPrinter1)
  87. end;
  88.  
  89. type
  90. PSRect = ^TSRect;
  91. TSRect = object(TWindow)
  92.   W,H:Integer;
  93.     State:Integer;
  94.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  95.       NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  96.   destructor Done;virtual;
  97.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  98.   procedure SetupWindow;virtual;
  99. end;
  100.  
  101. type
  102. PSText = ^TSText;
  103. TSText = object(TSRect)
  104.     Text:Array [0..80] of Char;
  105.   DTStyle:Integer;
  106.   constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
  107.       NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  108.   destructor Done;virtual;
  109.   procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  110.   procedure SetText(NewText:PChar);virtual;
  111. end;
  112.  
  113.  
  114. {********************************************************************}
  115. {I M P L E M E N T A T I O N                                                     }
  116. {********************************************************************}
  117. implementation
  118.  
  119. {********************************************************************}
  120.  
  121. constructor    TODButton.Init(AParent:PWindowsObject; AnID:Integer;ATitle:PChar;
  122.        X,Y,W,H:Integer;IsDefault:Boolean;BMP:PChar);
  123. begin
  124.     TButton.Init(AParent,AnID,ATitle,X,Y,W,H,IsDefault);
  125.   Attr.Style := Attr.Style or bs_OwnerDraw;
  126.   HBmp := LoadBitmap(HInstance,BMP);
  127. end;
  128.  
  129. destructor    TODButton.Done;
  130. begin
  131.     TButton.Done;
  132.     DeleteObject(HBmp);
  133. end;
  134.  
  135.  
  136. procedure    TODButton.DrawItem(var Msg:TMessage);
  137. var
  138.     TheDC:HDc;
  139.     ThePen:HPen;
  140.   Pen1:HPen;
  141.   Pen2:HPen;
  142.   TheBrush :HBrush;
  143.   OldBrush :HBrush;
  144.   OldPen:HPen;
  145.   OldBitMap:HBitMap;
  146.   MemDC :HDC;
  147.   LPts:Array[0..2] of TPoint;
  148.   RPts:Array[0..2] of TPoint;
  149.   PDIS :^TDrawItemStruct;
  150.   X,Y,W,H:Integer;
  151. begin
  152.     PDIS := Pointer(Msg.lParam);
  153.   if PDIS^.itemAction = oda_Focus then Exit;
  154.     if ((PDIS^.itemAction and oda_Select ) > 0) and
  155.       ((PDIS^.itemState and ods_Selected) > 0) then
  156.       State := 1 else State := 0; ;
  157.  
  158.   X := PDIS^.rcItem.left;Y := PDIS^.rcItem.top;
  159.   W := PDIS^.rcItem.right-PDIS^.rcItem.left;
  160.   H := PDIS^.rcItem.bottom-PDIS^.rcItem.top;
  161.   LPts[0].x := W; LPts[0].y := 0;
  162.   LPts[1].x := 0; LPts[1].y := 0;
  163.   LPts[2].x := 0; LPts[2].y := H;
  164.   RPts[0].x := 0; RPts[0].y := H;
  165.   RPts[1].x := W; RPts[1].y := H;
  166.   RPts[2].x := W; RPts[2].y := 0;
  167.   MemDC := CreateCompatibleDC(PDIS^.HDC);
  168.   OldBitMap := SelectObject(MemDC,HBMP);
  169.   if State = 0 then
  170.         BitBlt(PDIS^.HDC,X,Y,W,H, MemDC,0,0,SrcCopy)
  171.   else
  172.       BitBlt(PDIS^.HDC,X+2,Y+2,W,H, MemDC,0,0,SrcCopy);
  173.   SelectObject(MemDC,OldBitMap);
  174.   DeleteDC(MemDC);
  175.  
  176.     Pen1 := CreatePen(ps_Solid,2,$00000000);
  177.   OldPen := SelectObject(PDIS^.HDC,Pen1);
  178.   PolyLine(PDIS^.HDC,LPts,3);
  179.   PolyLine(PDIS^.HDC,RPts,3);
  180.   SelectObject(PDIS^.HDC,OldPen);
  181.   DeleteObject(Pen1);
  182.  
  183.   LPts[0].x := W-2; LPts[0].y := 2;
  184.   LPts[1].x := 2; LPts[1].y := 2;
  185.   LPts[2].x := 2;LPts[2].y := H-2;
  186.   RPts[0].x := 1; RPts[0].y := H-1;
  187.   RPts[1].x := W-1; RPts[1].y := H-1;
  188.   RPts[2].x := W-1; RPts[2].y := 1;
  189.   if State = 0 then
  190.       begin
  191.         Pen1 := CreatePen(ps_Solid,2,$00FFFFFF);
  192.     Pen2 := CreatePen(ps_Solid,2,$00808080);
  193.     end
  194.   else
  195.       begin
  196.         Pen2 := CreatePen(ps_Solid,1,$00808080);
  197.       Pen1 := CreatePen(ps_Solid,2,$00808080);
  198.     end;
  199.  
  200.   OldPen := SelectObject(PDIS^.HDC,Pen1);
  201.   PolyLine(PDIS^.HDC,LPts,3);
  202.  
  203.   SelectObject(PDIS^.HDC,Pen2);
  204.   DeleteObject(Pen1);
  205.  
  206.   PolyLine(PDIS^.HDC,RPts,3);
  207.   SelectObject(PDIS^.HDC,OldPen);
  208.   DeleteObject(Pen2);
  209. end;
  210.  
  211. {***********************************************************************}
  212. constructor TTextObj.Init(NewText:PChar);
  213. begin
  214.     Text := StrNew(NewText);
  215. end;
  216.  
  217. destructor TTextObj.Done;
  218. begin
  219.     StrDispose(Text);
  220. end;
  221.  
  222. {***********************************************************************}
  223. constructor TIntObj.Init(NewInt:Integer);
  224. begin
  225.     Int := NewInt;
  226. end;
  227.  
  228. destructor TIntObj.Done;
  229. begin
  230.  
  231. end;
  232. {***********************************************************************}
  233. procedure TStack.Push(Item:Pointer);
  234. begin
  235.     AtInsert(0,Item);
  236. end;
  237.  
  238. function TStack.Pop:Pointer;
  239. begin
  240.     Pop := At(0);
  241.   AtDelete(0);
  242. end;
  243.  
  244.  
  245. {***********************************************************************}
  246. {TTextStream Methods}
  247. constructor TTextStream.Init(FileName:PChar; Mode,Size:Word);
  248. begin
  249.     TBufStream.Init(FileName,Mode,Size);
  250.   CharsRead := 0;
  251.   CharsToRead := TBufStream.GetSize;
  252.   ARecord := MemAlloc(32000);
  253. end;
  254.  
  255. {Done}
  256. destructor TTextStream.Done;
  257. begin
  258.     TBufStream.Done;
  259.   FreeMem(ARecord,32000);
  260. end;
  261.  
  262. {GetNext}  {replace unwanted control chars with spaces 10/5/91}
  263. function TTextStream.GetNext:PChar;
  264. var
  265.     Blksize:Integer;
  266.   AChar:Char;
  267.   Indx : Integer;
  268.   IsEOR : Boolean;
  269. begin
  270.     Indx := 0;
  271.   IsEOR := False;
  272.   ARecord[0] := #0;
  273.   while (CharsRead < CharsToRead) and (IsEOR = False) do
  274.       begin
  275.       TBufStream.Read(AChar,1);
  276.     Inc(CharsRead);
  277.     case AChar of
  278.       #13:
  279.           begin
  280.         ARecord[Indx] := #0;
  281.         IsEOR := True;
  282.         end;
  283.         #26:
  284.           begin
  285.         if Indx > 0 then
  286.             begin
  287.           ARecord[Indx] := #0;
  288.           IsEOR := True;
  289.           end;
  290.         end;
  291.       #10:
  292.           begin
  293.         end;
  294.       #9:
  295.           begin
  296.         ARecord[Indx] := AChar;
  297.         Inc(Indx);
  298.         end;
  299.       #0..#31:
  300.           begin
  301.         ARecord[Indx] := ' ';
  302.         Inc(Indx);
  303.         end;
  304.       else
  305.           begin
  306.         ARecord[Indx] := AChar;
  307.         inc(Indx);
  308.         end;
  309.     end;
  310.   end;
  311.   ARecord[Indx] := #0;
  312.   GetNext := ARecord;
  313. end;
  314.  
  315. {WriteNext}
  316. {This method not actually used due to performance loss - instead
  317.    TStream.Write is called directly}
  318. function TTextStream.WriteNext(szARecord:PChar):Integer;
  319. const
  320.   CRLF : Array[0..2] of Char = #13#10#0;
  321.  
  322. begin
  323.     TBufStream.Write(szARecord,
  324.     StrLen(szARecord));
  325.     TBufStream.Write(CRLF,2);
  326.     WriteNext := StrLen(szARecord);
  327. end;
  328.  
  329. {WriteEOF}
  330. function TTextStream.WriteEOF:Integer;
  331. const
  332.       EOF : Array[0..1] of Char  = #26;
  333. begin
  334.     TBufStream.Write(EOF,1);
  335.    WriteEOF := 1;
  336. end;
  337.  
  338. {IsEOF}
  339. function TTextStream.IsEOF:Boolean;
  340. begin
  341.     IsEOF := False;
  342.     if CharsRead >= CharsToRead then
  343.        IsEOF := True;
  344. end;
  345.  
  346. {GetPctDone}
  347. function TTextStream.GetPctDone:Integer;
  348. begin
  349.     GetPctDone := CharsRead*100 div CharsToRead;
  350. end;
  351.  
  352.  
  353. {**********************************************************************}
  354. {TMeterWindow Methods}
  355. {Init}
  356. constructor TMeterWindow.Init(Aparent:PWindowsObject;ATitle:PChar);
  357. begin
  358.     TWindow.Init(AParent,ATitle);
  359.   DisableAutoCreate;
  360.      ThePen := CreatePen(ps_Solid,0,$00000000);
  361.   TheGrayBrush := CreateSolidBrush($00C0C0C0);
  362.   TheRedBrush  := CreateSolidBrush(RGB(255,0,0));
  363.   with Attr do
  364.        begin
  365.       X := 100;Y :=100 ;W := 350;H := 95;
  366.       Style := ws_Popup or ws_Visible or ws_Border or ws_Caption;
  367.        end;
  368.   X := 50;
  369.   Y := 10;
  370.   dX := 275;
  371.   dY := 30;
  372.   mX := 50;   {midpoint between X & X+dX}
  373.   PctDone := 0;
  374. end;
  375.  
  376. procedure TMeterWindow.SetupWindow;
  377. begin
  378.     TWindow.SetupWindow;
  379.     Icon :=LoadIcon(HInstance,'WOP_Icon1');
  380. end;
  381.  
  382. {Done}
  383. destructor TMeterWindow.Done;
  384. begin
  385.      DeleteObject(TheGrayBrush);
  386.   DeleteObject(TheRedBrush);
  387.   DeleteObject(ThePen);
  388.   Destroy;
  389.   TWindow.Done;
  390. end;
  391.  
  392. procedure TMeterWindow.Draw(NewPctDone:Integer);
  393. var
  394. Rgn:TRect;
  395. begin
  396.     PctDone := NewPctDone;
  397.     If PctDone > 0 then
  398.        mX :=  X + ((dX * PctDone) div 100)
  399.    else
  400.        mX := X;
  401.    Rgn.Left := X;
  402.    Rgn.Top := Y;
  403.    Rgn.Right := Max(210,mx);
  404.    Rgn.Bottom := Y+dY+20;
  405.    InvalidateRect(HWindow,@Rgn,false);
  406.    UpdateWindow(HWindow); 
  407. end;
  408.  
  409. procedure TMeterWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  410. var
  411.     OldBrush : HBrush;
  412.   OldPen :HPen;
  413.   OldColor : LongInt;
  414.   OldBkMode : Integer;
  415.   Buf  : Array[0..6] of Char;
  416. begin
  417.     DrawIcon(PaintDC,10,10,Icon);
  418.   OldPen := SelectObject(PaintDC,ThePen);
  419.   OldBrush := SelectObject(PaintDC,TheGrayBrush);
  420.   Rectangle(PaintDC,X,Y,mX,Y+dY);
  421.   Str(PctDone:2, Buf);
  422.   StrCat(Buf,'%');
  423.   SetTextAlign(PaintDC,ta_left);
  424.   OldColor := SetTextColor(PaintDC,RGB(255,0,0));  {Red}
  425.   {OldBkMode := SetBkMode(PaintDC,Transparent);}
  426.   TextOut(PaintDC,180,42,Buf,StrLen(Buf));
  427.   SelectObject(PaintDC,OldBrush);
  428.   SelectObject(PaintDC,OldPen);
  429.   SetTextColor(PaintDC,Oldcolor);
  430.   {SetBkMode(PaintDC,OldBkMode);}
  431. end;
  432.  
  433. {***********************************************************************}
  434. constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
  435.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  436. begin
  437.     TWindow.Init(AParent,ATitle);
  438.   Attr.Style := ws_Child or ws_visible ;
  439.   Attr.X := NewX;
  440.   Attr.Y := NewY;
  441.   Attr.W := NewW;
  442.   Attr.H := NewH;
  443.   Attr.ID := AnID;
  444.   W := NewW;
  445.   H := NewH;
  446.   if NewState = sr_Recessed then
  447.       State := sr_Recessed
  448.     else
  449.         State := sr_Raised;
  450. end;
  451.  
  452. destructor TSRect.Done;
  453. begin
  454.     TWindow.Done;
  455. end;
  456.  
  457. procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  458. var
  459.   LPts:Array[0..2] of TPoint;
  460.   RPts:Array[0..2] of TPoint;
  461.     ThePen:HPen;
  462.   Pen1:HPen;
  463.   Pen2:HPen;
  464.   TheBrush :HBrush;
  465.   OldBrush :HBrush;
  466.   OldPen:HPen;
  467.   OldBkMode:Integer;
  468.   DRect:TRect;
  469.   Ofs:Integer;
  470. begin
  471.   TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  472.   OldBrush := SelectObject(PaintDC,TheBrush);
  473.   Rectangle(PaintDC,0,0,W,H);
  474.   SelectObject(PaintDC,OldBrush);
  475.  
  476.   Ofs := 0;
  477.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  478.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  479.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  480.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  481.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  482.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  483.  
  484.     Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  485.   OldPen := SelectObject(PaintDC,Pen1);
  486.   PolyLine(PaintDC,LPts,3);
  487.   PolyLine(PaintDC,RPts,3);
  488.   SelectObject(PaintDC,OldPen);
  489.   DeleteObject(Pen1);
  490.  
  491.   Ofs := 1;
  492.     LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
  493.     LPts[1].x := Ofs;   LPts[1].y := Ofs;
  494.   LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  495.   RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
  496.     RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
  497.     RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  498.   if State = sr_Raised then
  499.       begin
  500.         Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
  501.     Pen2 := CreatePen(ps_Solid,1,$00808080);
  502.     end
  503.   else
  504.       begin
  505.       Pen1 := CreatePen(ps_Solid,1,$00808080);
  506.         Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
  507.     end;
  508.  
  509.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  510.   PolyLine(PaintDC,LPts,3);
  511.   SelectObject(PaintDC,Pen2);
  512.   DeleteObject(Pen1);
  513.  
  514.   PolyLine(PaintDC,RPts,3);
  515.   SelectObject(PaintDC,OldPen);
  516.   DeleteObject(Pen2);
  517. end;
  518.  
  519. procedure TSRect.SetupWindow;
  520. begin
  521.  
  522. end;
  523. {***********************************************************************}
  524. constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
  525.     ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  526. begin
  527.     TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  528.   DTStyle := NewStyle;
  529.   StrCopy(Text,ATitle);
  530. end;
  531.  
  532. destructor TSText.Done;
  533. begin
  534.     TSRect.Done;
  535. end;
  536.  
  537. procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  538. var
  539.   OldBkMode:Integer;
  540.   DRect:TRect;
  541. begin
  542.   TSRect.Paint(PaintDC,PaintInfo);
  543.   OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  544.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  545.   DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  546.   SetBkMode(PaintDC,OldBkMode);
  547. end;
  548.  
  549. procedure TSText.SetText(NewText:PChar);
  550. var
  551.     DRect:TRect;
  552. begin
  553.     StrCopy(Text,NewText);
  554.   DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  555.   InvalidateRect(HWindow,@DRect,false);
  556. end;
  557.  
  558.  
  559. end.
  560.